00100		TITLE	SOUND;  DOROTHY BENDER ****** 1969 *******
00200	
00300	;  ROUTINE TO READ THE OUTPUT FROM THE MUSIC
00400	;  PROGRAM AND CALL THE D-A CONVERTER TO PLAY.
00500	;  
00600	;  NAME OF THE FILE TO BE INPUTTED IS 'MUSIC.MUS' OR 'MUSAA.DMD',
00700	;  THE FIRST RECORD OF WHICH CONTAINS THE
00800	;  NUMBER OF WORDS OF DATA IN THE ENTIRE DISK FILE.
00900	
01000	A   ←   1     ;WORK
01100	B   ←   2     ;WORK
01200	RET ←   3     ;RETURN ACCUMULATOR
01300	BUFSIZ ←=20224   ;****** DOUBLE THIS FOR 4-CHANNEL SOUND!!!!!	
01400	↓DSKCHN ←1             ;DISK CHANNEL FOR INPUT
01500	↓ADCHN  ←2             ;D-A CHANNEL FOR OUTPUT
01600	
01700		OPDEF	READCH [51B8]
01800	        OPDEF   MESSAGE[51B8!3B12]
01900	
02000	BEG:	CALLI	0,0         ;RESET I/O DEVICES
02100	 	OPEN 	DSKCHN,[17  ;MODE
02200			'DSK   '    ;DEVICE NAME
02300	 		0]          ;NO BUFFER HEADERS
02400		HALT	BEG         ;RESTART IF DEVICE IS UNAVAILABLE
02500	
02600	 	SETZM	FILBLK+3    ;FOR RESTART
02700	 	SETZM	FILBL2+3    ;FOR RESTART
02800	LX:	MESSAGE [ASCIZ/
02900	  TYPE `P' TO PLAY FROM DISK, `C' TO COPY TAPE TO DISK.
03000	/]
03100		readch a
03200		cain a,"C"
03300		jrst start
03400		caie a,"P"
03500		jrst lx
03600		skipe filblk+3	;is this first time through ?
03700		jrst pla2	;No. Parameters already set up.
03800		;FIND OUT NUMBER OF CHANNELS AND
03900		;THE SPEED.
04000	
04100		MESSAGE	[ASCIZ/HOW MANY CHANNELS?/]
04200		READCH	A
04300		SUBI	A,"0"+1		;CONVERT TO BINR AND ADD 1
04400		DPB	A,[POINT 2,OUTBIT,26]
04500	
04600		MESSAGE [ASCIZ/WHAT IS THE SPEED?/]
04700		READCH  A
04800		SUBI	A,"0"
04900		DPB	A,[POINT 3,OUTBIT,32]
05000	
05100	PLA2:	SETZM FILBLK+3
05200		SETZM FILBL2+3
05300		LOOKUP	DSKCHN,FILBLK
05400		SKIPA			;CAN'T FIND MUSIC.MUS
05500		JRST XOPEN		;FOUND IT
05600		LOOKUP  DSKCHN,FILBL2	;TRY FOR MUSAA.DMD
05700	
05800		JRST	[MESSAGE[ASCIZ/
05900			*** MUSIC FILE NOT FOUND/]
06000			CALLI  12]
06100	        ;EXIT IF FILE IS MISSING
06200		MOVE A,FILBL2+3	;GET LENGTH OF MUSAA.DMD
06300		MOVEM A,FILBLK+3;PUT IT IN RIGHT PLACE
06400	
06500	XOPEN:	MOVSI	'XGP'	;DOWN TO XGPOK FOR XGP CONFLICT.
06600		DEVUSE	0,	
06700		HLRZ 	0,0
06800		CAIN	400000
06900		JRST	XGPOK
07000		INIT	16,17
07100		SIXBIT	.XGP.
07200		0
07300		JRA	16,2(16)
07400	XGPOK:	OPEN	ADCHN,[117 	;MODE
07500	         	'AD    '        ;DEVICE NAME
07600	 		0]              ;NO BUFFER HEADERS
07700	
07800	  	JRST	[MESSAGE[ASCIZ/
07900			***D-A NOT AVAILABLE/]
08000			CALLI  12]
08100		;EXIT IF D-A IS UNAVAILABLE
08200	
08250	SPWAR:	LOCK A,
08300		SPCWAR 17,[CALLI]
08400	;;	MESSAGE [ASCIZ/ GO? /]
08500	;;	READCH A
08600	
08700	
08800	LNTH:	movs a,filblk+3		;get length of file.
08900		movnm a,nwd
09000	
09100	;	-----------------------------------------
09200	
09300		;BEGIN MAIN BODY OF PROGRAM
09400	
09500	LOOP:	JSP	RET,SUB		;ROUTINE TO READ AND WRITE
09600		BUF1-1 			;USE BUF1 FOR THE I/O
09700		JUMPLE	B,OUT    	;DONE
09800		
09900		JSP	RET,SUB		;CALL IT AGAIN
10000		BUF2-1			;USE BUF2 FOR THE I/O
10100		JUMPG	B,LOOP		;GO BACK FOR MORE IF B>0
10200	
10300	OUT:	close dskchn,		;END OF PROGRAM.
10400		releas adchn,
10500		SPCWAR 0,'SSW'
10550		UNLOCK
10600		RELEASE 16,
10700		jrst lx
10800	
10900		;SUBROUTINE TO SET UP IOWD AND READ AND WRITE.
11000		;  1(RET) WILL BE THE RETURN
11100		;  0(RET) WILL BE THE ADDRESS OF THE BUFFER TO BE
11200		;         PUT IN THE RIGHT HALF OF THE IOWD.
11300		;  A      WILL BE A WORK REGISTER
11400	    	;  B      WILL BE TESTED ON THE OUTSIDE.
11500	
11600	SUB:	MOVNI	A,BUFSIZ	;PICK UP AND COMPLEMENT BUFSIZ
11700		ADDB	A,NWD		;A←NWD-BUFSIZ
11800					;NWD←NWD-BUFSIZ
11900		MOVE	B,A		;SAVE B TO BE TESTED FOR LAST
12000					;TIME.
12100		JUMPL	A,LAST		;SET UP FOR LAST TIME.
12200		MOVEI	A,0		
12300	
12400		;THE IOWD LOOKS LIKE:
12500		;  [-BUFSIZ / BUFI-1]
12600	
12700	LAST:	ADDI	A,BUFSIZ
12800		MOVNS	A		;COMPLEMENT A
12900		HRL	A,0(RET)	;PICK UP BUFI AND MOVE IT
13000					;TO THE LEFT SIDE OF A.
13100		MOVSM	A,INLIST	;SWAP A AND MOVE IT.
13200		MOVSM	A,OUTWC		;SAME FOR OUTPUT.
13300		INPUT	DSKCHN,INLIST	;READ A RECORD.
13400		OUTPUT	ADCHN,OUTWC	;WRITE THE RECORD.
13500		JRST	1(RET)		;RETURN
13600	
13700	;	-----------------------------------------
13800	
13900	; STORAGE:
14000	
14100	NWD:	0			;FOR NUMBER OF WORDS OF INPUT.
14200	↓BUF1:	BLOCK	BUFSIZ+1	;BUFFER 1
14300	BUF2:	BLOCK	BUFSIZ+1	;BUFFER 2
14400	
14500	FILBLK: 'MUSIC '		;FILENAME FOR INPUT
14600		'MUS   '			;EXTENSION
14700		0			;INFORMATION ON FILE
14800		0			;PROJECT PROG#
14900	
15000	FILBL2: 'MUSAA '		;FILENAME FOR INPUT, 2ND CHOICE
15100		'DMD   '			;EXTENSION
15200		0			;INFORMATION ON FILE
15300		0			;PROJECT PROG#
15400	
15500	CLIST:	IOWD	1,NWD		;FOR THE FIRST RECORD
15600		0
15700	
15800	INLIST:	0			;WILL CONTAIN AN IOWD
15900		0
16000	
16100	OUTWC:	0			;WILL CONTAIN AN IOWD FOR D-A
16200		3650			;MAGIC BITS FOR 136.
16300	OUTBIT: 4000			;BITS FOR D-A
16400		BLOCK	2
16500	
16600	begin magdsk
16700	
16800	A←1
16900	B←2
17000	D←3
17100	OLNG←=2432	;size of mag tape records. must be multiple of =128.
17200	
17300	ILNG←=2432
17400	ichn←adchn
17500	ochn←dskchn
17600	↑START:	CALLI 0
17700		INIT ICHN,3B28+17
17800		SIXBIT /MTA0/
17900		0
18000		HALT
18100		MTAPE ICHN,1	;REWIND THE TAPE
18200		JFCL
18300		INIT OCHN,17
18400		SIXBIT /DSK/
18500		0
18600		HALT
18700		ENTER OCHN,[SIXBIT /MUSIC/
18800	                    SIXBIT /MUS/
18900		            0
19000		            0]
19100		HALT
19200		loop:input ichn,olst
19300			statz ichn,20000
19400			jrst out	;end of tape.
19500			output ochn,olst
19600			jrst loop
19700	OLST:	IOWD OLNG,OBUF
19800		0
19900	obuf←← buf1
20000		bend magdsk
20100	
20200	end beg